Trust in Artificial Intelligent Agents Scale

First quantitative approbation. Data analysis workflow

Packages

library(tidyverse)
library(psych)
library(lavaan)
library(semPlot)
library(knitr)
library(corrplot)
theme_set(theme_bw())

Import data

taia <- read_csv("https://github.com/angelgardt/taia/raw/master/data/taia.csv")

Preparation

Vectors of TAIA items:

pr_items <- colnames(taia)[1:10]
co_items <- colnames(taia)[11:20]
ut_items <- colnames(taia)[21:32]
fa_items <- colnames(taia)[33:42]
de_items <- colnames(taia)[43:53]
un_items <- colnames(taia)[54:65]
taia_items <- colnames(taia)[1:65]

Vector of GT items:

gt_items <- colnames(taia)[66:71]

Column names for further formatting:

col_names <- c("", "Num. of obs.", "Mean", "SD",
               "Median", "Trimmed Mean", "MAD",
               "Min", "Max", "Range",
               "Skewness", "Kurtuosis", "SE")
total_colnames <- c("Alpha", "Standardized Alpha", "Guttman's Lambda 6",
                    "Average interitem correlation", "S/N",
                    "Alpha SE", "Scale Mean", "Total Score SD",
                    "Median interitem correlation")
item_stats_colnames <- c("Num. of Obs.", "Discrimination",
                         "Std Cor",
                         "Cor Overlap Corrected",
                         "Cor if drop",
                         "Difficulty", "SD")
alpha_drop <- c("Alpha", "Standardized Alpha",
                "Guttman's Lambda 6",   "Average interitem correlation",
                "S/N",  "Alpha SE", "Var(r)","Median interitem correlation")

Exploratory analysis

TAIA descriptive statistics

taia %>% 
  select(all_of(pr_items)) %>% 
  describe() %>% 
  kable(caption = "Predictability", label = 1, digits = 2, col.names = col_names)

Table 1: Predictability

		Num. of obs.	Mean	SD	Median	Trimmed Mean	MAD	Min	Max	Range	Skewness	Kurtuosis	SE
pr01	1	513	2.84	1.00	3	2.88	1.48	0	5	5	-0.32	0.44	0.04
pr02	2	513	2.75	0.98	3	2.79	1.48	0	5	5	-0.21	0.12	0.04
pr03	3	513	2.86	1.04	3	2.89	1.48	0	5	5	-0.16	-0.04	0.05
pr04	4	513	2.81	1.07	3	2.85	1.48	0	5	5	-0.19	-0.02	0.05
pr05	5	513	2.25	1.21	2	2.26	1.48	0	5	5	0.02	-0.32	0.05
pr06	6	513	3.05	1.08	3	3.07	1.48	0	5	5	-0.27	0.07	0.05
pr07	7	513	2.60	1.12	3	2.63	1.48	0	5	5	-0.17	-0.10	0.05
pr08	8	513	3.04	0.92	3	3.09	0.00	0	5	5	-0.55	1.25	0.04
pr09	9	513	2.91	0.97	3	2.95	0.00	0	5	5	-0.48	1.00	0.04
pr10	10	513	2.84	1.04	3	2.90	1.48	0	5	5	-0.41	0.31	0.05

taia %>% 
  select(all_of(co_items)) %>% 
  describe() %>% 
  kable(caption = "Consistency", label = 2, digits = 2, col.names = col_names)

Table 2: Consistency

		Num. of obs.	Mean	SD	Median	Trimmed Mean	MAD	Min	Max	Range	Skewness	Kurtuosis	SE
co01	1	513	2.51	1.09	3	2.53	1.48	0	5	5	-0.15	0.12	0.05
co02	2	513	2.52	1.06	3	2.54	1.48	0	5	5	-0.18	-0.04	0.05
co03	3	513	2.87	1.03	3	2.93	1.48	0	5	5	-0.38	0.33	0.05
co04	4	513	3.46	1.10	4	3.53	1.48	0	5	5	-0.57	0.32	0.05
co05	5	513	2.22	1.13	2	2.20	1.48	0	5	5	0.13	-0.17	0.05
co06	6	513	2.52	1.12	3	2.53	1.48	0	5	5	-0.12	-0.15	0.05
co07	7	513	1.60	1.14	2	1.54	1.48	0	5	5	0.53	0.09	0.05
co08	8	513	1.93	1.07	2	1.88	1.48	0	5	5	0.42	0.22	0.05
co09	9	513	2.08	1.09	2	2.03	1.48	0	5	5	0.34	0.09	0.05
co10	10	513	2.46	1.11	2	2.46	1.48	0	5	5	-0.04	-0.07	0.05

taia %>% 
  select(all_of(ut_items)) %>% 
  describe() %>% 
  kable(caption = "Utility", label = 3, digits = 2, col.names = col_names)

Table 3: Utility

		Num. of obs.	Mean	SD	Median	Trimmed Mean	MAD	Min	Max	Range	Skewness	Kurtuosis	SE
ut01	1	513	3.75	1.07	4	3.87	1.48	0	5	5	-0.87	1.08	0.05
ut02	2	513	3.52	1.06	3	3.58	1.48	0	5	5	-0.54	0.54	0.05
ut03	3	513	3.51	1.14	4	3.60	1.48	0	5	5	-0.57	0.06	0.05
ut04	4	513	3.10	1.12	3	3.15	1.48	0	5	5	-0.43	0.04	0.05
ut05	5	513	3.05	1.21	3	3.10	1.48	0	5	5	-0.34	-0.16	0.05
ut06	6	513	3.27	1.10	3	3.31	1.48	0	5	5	-0.61	0.64	0.05
ut07	7	513	3.20	1.13	3	3.22	1.48	0	5	5	-0.29	-0.19	0.05
ut08	8	513	3.43	1.06	3	3.48	1.48	0	5	5	-0.57	0.47	0.05
ut09	9	513	3.18	1.17	3	3.24	1.48	0	5	5	-0.48	0.17	0.05
ut10	10	513	2.17	1.12	2	2.15	1.48	0	5	5	0.09	-0.22	0.05
ut11	11	513	2.69	1.24	3	2.71	1.48	0	5	5	-0.13	-0.41	0.05
ut12	12	513	3.16	1.15	3	3.21	1.48	0	5	5	-0.43	0.05	0.05

taia %>% 
  select(all_of(fa_items)) %>% 
  describe() %>% 
  kable(caption = "Faith", label = 4, digits = 2, col.names = col_names)

Table 4: Faith

		Num. of obs.	Mean	SD	Median	Trimmed Mean	MAD	Min	Max	Range	Skewness	Kurtuosis	SE
fa01	1	513	2.44	1.11	2	2.44	1.48	0	5	5	-0.03	-0.27	0.05
fa02	2	513	2.16	1.18	2	2.14	1.48	0	5	5	0.16	-0.42	0.05
fa03	3	513	1.54	1.15	1	1.45	1.48	0	5	5	0.66	0.18	0.05
fa04	4	513	1.61	1.10	2	1.55	1.48	0	5	5	0.54	0.12	0.05
fa05	5	513	2.47	1.11	3	2.49	1.48	0	5	5	-0.13	-0.09	0.05
fa06	6	513	2.49	1.08	3	2.50	1.48	0	5	5	-0.17	0.07	0.05
fa07	7	513	2.36	1.08	2	2.36	1.48	0	5	5	-0.12	-0.15	0.05
fa08	8	513	2.20	1.14	2	2.16	1.48	0	5	5	0.26	-0.12	0.05
fa09	9	513	2.29	1.18	2	2.28	1.48	0	5	5	0.11	-0.41	0.05
fa10	10	513	2.64	1.20	3	2.62	1.48	0	5	5	0.06	-0.31	0.05

taia %>% 
  select(all_of(de_items)) %>% 
  describe() %>% 
  kable(caption = "Dependability", label = 5, digits = 2, col.names = col_names)

Table 5: Dependability

		Num. of obs.	Mean	SD	Median	Trimmed Mean	MAD	Min	Max	Range	Skewness	Kurtuosis	SE
de01	1	513	2.60	1.11	3	2.65	1.48	0	5	5	-0.41	0.07	0.05
de02	2	513	2.19	1.16	2	2.20	1.48	0	5	5	0.00	-0.33	0.05
de03	3	513	2.19	1.21	2	2.20	1.48	0	5	5	0.02	-0.31	0.05
de04	4	513	1.91	1.06	2	1.86	1.48	0	5	5	0.55	0.57	0.05
de05	5	513	3.53	1.18	4	3.64	1.48	0	5	5	-0.78	0.46	0.05
de06	6	513	2.23	1.23	2	2.25	1.48	0	5	5	0.00	-0.44	0.05
de07	7	513	2.82	1.02	3	2.86	1.48	0	5	5	-0.31	0.32	0.04
de08	8	513	2.64	1.05	3	2.69	1.48	0	5	5	-0.40	0.14	0.05
de09	9	513	3.42	1.21	4	3.51	1.48	0	5	5	-0.57	-0.22	0.05
de10	10	513	2.26	1.20	2	2.29	1.48	0	5	5	-0.21	-0.41	0.05
de11	11	513	2.32	1.20	2	2.32	1.48	0	5	5	0.00	-0.52	0.05

taia %>%
  select(all_of(un_items)) %>% 
  describe() %>% 
  kable(caption = "Understanding", label = 6, digits = 2, col.names = col_names)

Table 6: Understanding

		Num. of obs.	Mean	SD	Median	Trimmed Mean	MAD	Min	Max	Range	Skewness	Kurtuosis	SE
un01	1	513	2.95	1.06	3	3.02	1.48	0	5	5	-0.48	0.31	0.05
un02	2	513	2.49	1.14	3	2.51	1.48	0	5	5	-0.19	-0.25	0.05
un03	3	513	3.02	1.17	3	3.09	1.48	0	5	5	-0.54	0.02	0.05
un04	4	513	2.62	1.09	3	2.67	1.48	0	5	5	-0.33	-0.18	0.05
un05	5	513	2.83	1.11	3	2.90	1.48	0	5	5	-0.49	0.23	0.05
un06	6	513	2.28	1.23	2	2.25	1.48	0	5	5	0.20	-0.60	0.05
un07	7	513	2.16	1.19	2	2.17	1.48	0	5	5	-0.01	-0.52	0.05
un08	8	513	2.90	1.16	3	2.96	1.48	0	5	5	-0.44	0.02	0.05
un09	9	513	2.34	1.23	2	2.39	1.48	0	5	5	-0.19	-0.71	0.05
un10	10	513	2.27	1.16	2	2.26	1.48	0	5	5	0.05	-0.44	0.05
un11	11	513	2.63	1.20	3	2.67	1.48	0	5	5	-0.24	-0.36	0.05
un12	12	513	2.89	1.13	3	2.95	1.48	0	5	5	-0.43	0.10	0.05

TAIA scores distributions

taia %>% select(all_of(pr_items)) %>% 
  pivot_longer(cols = pr_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "darkred") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Predictability") +
  theme(plot.title = element_text(hjust = .5))

taia %>% select(all_of(co_items)) %>% 
  pivot_longer(cols = co_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "chocolate3") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Consistency") +
  theme(plot.title = element_text(hjust = .5))

taia %>% select(all_of(ut_items)) %>% 
  pivot_longer(cols = ut_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "goldenrod3") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Utility") +
  theme(plot.title = element_text(hjust = .5))

taia %>% select(all_of(fa_items)) %>% 
  pivot_longer(cols = fa_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "darkgreen") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Faith") +
  theme(plot.title = element_text(hjust = .5))

taia %>% select(all_of(de_items)) %>% 
  pivot_longer(cols = de_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "darkblue") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Dependability") +
  theme(plot.title = element_text(hjust = .5))

taia %>% select(all_of(un_items)) %>% 
  pivot_longer(cols = un_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "purple4") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Understanding") +
  theme(plot.title = element_text(hjust = .5))

Correlations

Predictability

corrplot.mixed(cor(taia %>% select(all_of(pr_items))),
               lower.col = "black")

Consistency

corrplot.mixed(cor(taia %>% select(all_of(co_items))),
               lower.col = "black")

Utility

corrplot.mixed(cor(taia %>% select(all_of(ut_items))),
               lower.col = "black")

Faith

corrplot.mixed(cor(taia %>% select(all_of(fa_items))),
               lower.col = "black")

Dependability

corrplot.mixed(cor(taia %>% select(all_of(de_items))),
               lower.col = "black")

Understanding

corrplot.mixed(cor(taia %>% select(all_of(un_items))),
               lower.col = "black")

All TAIA items correlations

qgraph::qgraph(
  cor(taia %>% select(all_of(taia_items))),
  layout = "spring",
  posCol = "darkgreen",
  negCol = "darkred"
)

Psychometric Analysis

Subscales

Predictability

pr1 <- psych::alpha(
  taia %>% select(all_of(pr_items)),
  cumulative = TRUE,
  title = "Predictability Factor",
  check.keys = FALSE
)

kable(pr1$total,
      caption = "Perdictability. Subscale statistics", 
      label = 7, digits = 2,
      col.names = total_colnames
      )

Table 7: Perdictability. Subscale statistics

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Scale Mean	Total Score SD	Median interitem correlation
	0.8	0.8	0.82	0.29	4.1	0.01	27.95	6.25	0.36

pr1$item.stats$mean <- pr1$item.stats$mean / 5
kable(pr1$item.stats,
      caption = "Predictability. Items statistics",
      label = 8, digits = 2,
      col.names = item_stats_colnames)

Table 8: Predictability. Items statistics

	Num. of Obs.	Discrimination	Std Cor	Cor Overlap Corrected	Cor if drop	Difficulty	SD
pr01	513	0.77	0.78	0.78	0.70	0.57	1.00
pr02	513	0.67	0.67	0.63	0.57	0.55	0.98
pr03	513	0.39	0.39	0.29	0.23	0.57	1.04
pr04	513	0.29	0.28	0.17	0.12	0.56	1.07
pr05	513	0.61	0.59	0.52	0.47	0.45	1.21
pr06	513	0.64	0.63	0.57	0.51	0.61	1.08
pr07	513	0.74	0.73	0.71	0.64	0.52	1.12
pr08	513	0.73	0.74	0.71	0.64	0.61	0.92
pr09	513	0.62	0.63	0.57	0.51	0.58	0.97
pr10	513	0.57	0.57	0.49	0.44	0.57	1.04

pr1$item.stats %>%
  ggplot(aes(x = row.names(pr1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Predictability. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))

kable(pr1$alpha.drop,
      caption = "Predictability. Subscale statistics when item drop",
      label = 9, digits = 2, col.names = alpha_drop)

Table 9: Predictability. Subscale statistics when item drop

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Var(r)	Median interitem correlation
pr01	0.76	0.76	0.78	0.26	3.18	0.02	0.03	0.32
pr02	0.77	0.78	0.79	0.28	3.49	0.01	0.04	0.32
pr03	0.81	0.81	0.82	0.33	4.37	0.01	0.03	0.38
pr04	0.82	0.83	0.82	0.34	4.72	0.01	0.02	0.38
pr05	0.78	0.79	0.81	0.29	3.71	0.01	0.03	0.36
pr06	0.78	0.78	0.80	0.29	3.60	0.01	0.03	0.34
pr07	0.76	0.77	0.79	0.27	3.32	0.02	0.03	0.32
pr08	0.77	0.77	0.79	0.27	3.30	0.02	0.03	0.32
pr09	0.78	0.78	0.80	0.29	3.61	0.01	0.03	0.35
pr10	0.79	0.79	0.81	0.30	3.79	0.01	0.03	0.37

kable(pr1$response.freq,
      caption = "Predictability. Non missing response frequency for each item",
      label = 10, digits = 2)

Table 10: Predictability. Non missing response frequency for each item

	0	1	2	3	4	5	miss
pr01	0.02	0.06	0.24	0.45	0.19	0.04	0
pr02	0.02	0.08	0.27	0.43	0.17	0.03	0
pr03	0.02	0.07	0.27	0.39	0.21	0.05	0
pr04	0.02	0.07	0.28	0.37	0.21	0.05	0
pr05	0.09	0.16	0.32	0.29	0.10	0.04	0
pr06	0.02	0.06	0.20	0.40	0.24	0.09	0
pr07	0.04	0.12	0.28	0.38	0.15	0.04	0
pr08	0.02	0.03	0.16	0.51	0.24	0.04	0
pr09	0.02	0.05	0.19	0.52	0.18	0.04	0
pr10	0.03	0.08	0.21	0.45	0.19	0.04	0

Consistency

co1 <- psych::alpha(
  taia %>% select(all_of(co_items)),
  cumulative = TRUE,
  title = "Consistency Factor",
  check.keys = FALSE
)

Some items ( co07 ) were negatively correlated with the total scale and 
probably should be reversed.  
To do this, run the function again with the 'check.keys=TRUE' option

kable(co1$total,
      caption = "Consistency. Subscale statistics", 
      label = 11, digits = 2,
      col.names = total_colnames)

Table 11: Consistency. Subscale statistics

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Scale Mean	Total Score SD	Median interitem correlation
	0.77	0.78	0.81	0.26	3.48	0.01	24.18	6.28	0.3

co1$item.stats$mean <- co1$item.stats$mean / 5
kable(co1$item.stats,
      caption = "Consistency. Items statistics",
      label = 12, digits = 2,
      col.names = item_stats_colnames)

Table 12: Consistency. Items statistics

	Num. of Obs.	Discrimination	Std Cor	Cor Overlap Corrected	Cor if drop	Difficulty	SD
co01	513	0.75	0.75	0.73	0.66	0.50	1.09
co02	513	0.69	0.70	0.67	0.59	0.50	1.06
co03	513	0.56	0.57	0.49	0.43	0.57	1.03
co04	513	0.42	0.42	0.33	0.26	0.69	1.10
co05	513	0.79	0.79	0.79	0.71	0.44	1.13
co06	513	0.66	0.66	0.62	0.54	0.50	1.12
co07	513	-0.07	-0.08	-0.25	-0.25	0.32	1.14
co08	513	0.49	0.49	0.40	0.34	0.39	1.07
co09	513	0.78	0.78	0.78	0.69	0.42	1.09
co10	513	0.69	0.69	0.64	0.58	0.49	1.11

co1$item.stats %>%
  ggplot(aes(x = row.names(co1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Consistency. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))

kable(co1$alpha.drop,
      caption = "Consistency. Subscale statistics when item drop",
      label = 13, digits = 2,
      col.names = alpha_drop)

Table 13: Consistency. Subscale statistics when item drop

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Var(r)	Median interitem correlation
co01	0.72	0.73	0.77	0.23	2.68	0.02	0.07	0.28
co02	0.74	0.74	0.78	0.24	2.82	0.02	0.07	0.29
co03	0.76	0.76	0.80	0.26	3.15	0.02	0.07	0.29
co04	0.78	0.78	0.81	0.28	3.55	0.01	0.07	0.37
co05	0.72	0.72	0.76	0.22	2.59	0.02	0.06	0.28
co06	0.74	0.74	0.79	0.24	2.91	0.02	0.07	0.29
co07	0.84	0.84	0.85	0.36	5.13	0.01	0.02	0.39
co08	0.77	0.77	0.80	0.27	3.36	0.01	0.07	0.35
co09	0.72	0.72	0.76	0.23	2.62	0.02	0.07	0.28
co10	0.74	0.74	0.78	0.24	2.84	0.02	0.07	0.28

kable(co1$response.freq,
      caption = "Consistency. Non missing response frequency for each item",
      label = 14, digits = 2)

Table 14: Consistency. Non missing response frequency for each item

	0	1	2	3	4	5	miss
co01	0.05	0.11	0.31	0.39	0.11	0.04	0
co02	0.04	0.12	0.32	0.37	0.13	0.02	0
co03	0.02	0.07	0.22	0.44	0.20	0.04	0
co04	0.01	0.04	0.11	0.34	0.32	0.18	0
co05	0.06	0.19	0.36	0.27	0.09	0.03	0
co06	0.04	0.14	0.28	0.38	0.12	0.04	0
co07	0.18	0.31	0.32	0.14	0.04	0.02	0
co08	0.08	0.26	0.42	0.17	0.06	0.02	0
co09	0.06	0.24	0.39	0.23	0.06	0.03	0
co10	0.04	0.13	0.33	0.34	0.12	0.04	0

Utility

ut1 <- psych::alpha(
  taia %>% select(all_of(ut_items)),
  cumulative = TRUE,
  title = "Utility Factor",
  check.keys = FALSE
)

Some items ( ut10 ) were negatively correlated with the total scale and 
probably should be reversed.  
To do this, run the function again with the 'check.keys=TRUE' option

kable(ut1$total,
      caption = "Utility. Subscale statistics", 
      label = 15, digits = 2,
      col.names = total_colnames)

Table 15: Utility. Subscale statistics

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Scale Mean	Total Score SD	Median interitem correlation
	0.86	0.86	0.88	0.34	6.21	0.01	38.03	8.52	0.39

ut1$item.stats$mean <- ut1$item.stats$mean / 5
kable(ut1$item.stats,
      caption = "Utility. Items statistics",
      label = 16, digits = 2,
      col.names = item_stats_colnames)

Table 16: Utility. Items statistics

	Num. of Obs.	Discrimination	Std Cor	Cor Overlap Corrected	Cor if drop	Difficulty	SD
ut01	513	0.78	0.78	0.78	0.72	0.75	1.07
ut02	513	0.83	0.83	0.84	0.78	0.70	1.06
ut03	513	0.52	0.52	0.46	0.42	0.70	1.14
ut04	513	0.53	0.53	0.46	0.43	0.62	1.12
ut05	513	0.70	0.70	0.66	0.62	0.61	1.21
ut06	513	0.77	0.77	0.76	0.71	0.65	1.10
ut07	513	0.64	0.64	0.60	0.55	0.64	1.13
ut08	513	0.67	0.67	0.64	0.59	0.69	1.06
ut09	513	0.69	0.69	0.66	0.61	0.64	1.17
ut10	513	0.13	0.14	0.02	0.00	0.43	1.12
ut11	513	0.57	0.56	0.49	0.46	0.54	1.24
ut12	513	0.72	0.72	0.69	0.65	0.63	1.15

ut1$item.stats %>%
  ggplot(aes(x = row.names(ut1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Utility. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))

kable(ut1$alpha.drop,
      caption = "Utility. Subscale statistics when item drop",
      label = 17, digits = 2,
      col.names = alpha_drop)

Table 17: Utility. Subscale statistics when item drop

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Var(r)	Median interitem correlation
ut01	0.84	0.84	0.85	0.32	5.18	0.01	0.04	0.33
ut02	0.83	0.83	0.85	0.31	5.02	0.01	0.03	0.33
ut03	0.86	0.86	0.87	0.36	6.07	0.01	0.04	0.42
ut04	0.86	0.86	0.87	0.35	6.04	0.01	0.04	0.42
ut05	0.84	0.85	0.86	0.33	5.46	0.01	0.04	0.39
ut06	0.84	0.84	0.86	0.32	5.22	0.01	0.04	0.33
ut07	0.85	0.85	0.86	0.34	5.66	0.01	0.04	0.39
ut08	0.85	0.85	0.86	0.33	5.54	0.01	0.04	0.39
ut09	0.84	0.85	0.86	0.33	5.49	0.01	0.04	0.39
ut10	0.88	0.88	0.89	0.41	7.61	0.01	0.02	0.42
ut11	0.85	0.86	0.87	0.35	5.94	0.01	0.04	0.42
ut12	0.84	0.84	0.86	0.33	5.38	0.01	0.04	0.37

kable(ut1$response.freq,
      caption = "Utility. Non missing response frequency for each item",
      label = 18, digits = 2)

Table 18: Utility. Non missing response frequency for each item

	0	1	2	3	4	5	miss
ut01	0.02	0.02	0.06	0.29	0.34	0.27	0
ut02	0.01	0.02	0.09	0.38	0.30	0.20	0
ut03	0.01	0.04	0.10	0.32	0.30	0.22	0
ut04	0.02	0.08	0.15	0.40	0.27	0.09	0
ut05	0.03	0.06	0.21	0.34	0.23	0.12	0
ut06	0.03	0.03	0.14	0.38	0.30	0.12	0
ut07	0.02	0.05	0.19	0.35	0.27	0.13	0
ut08	0.01	0.03	0.12	0.35	0.34	0.15	0
ut09	0.03	0.05	0.15	0.38	0.26	0.13	0
ut10	0.07	0.19	0.37	0.26	0.09	0.02	0
ut11	0.05	0.12	0.27	0.31	0.19	0.07	0
ut12	0.02	0.06	0.15	0.38	0.26	0.12	0

Faith

fa1 <- psych::alpha(
  taia %>% select(all_of(fa_items)),
  cumulative = TRUE,
  title = "Faith Factor",
  check.keys = FALSE
)

kable(fa1$total,
      caption = "Faith. Subscale statistics", 
      label = 19, digits = 2,
      col.names = total_colnames)

Table 19: Faith. Subscale statistics

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Scale Mean	Total Score SD	Median interitem correlation
	0.76	0.76	0.81	0.24	3.12	0.02	22.18	6.36	0.25

fa1$item.stats$mean <- fa1$item.stats$mean / 5
kable(fa1$item.stats,
      caption = "Faith. Items statistics",
      label = 20, digits = 2,
      col.names = item_stats_colnames)

Table 20: Faith. Items statistics

	Num. of Obs.	Discrimination	Std Cor	Cor Overlap Corrected	Cor if drop	Difficulty	SD
fa01	513	0.76	0.76	0.77	0.67	0.49	1.11
fa02	513	0.59	0.58	0.54	0.45	0.43	1.18
fa03	513	0.29	0.29	0.17	0.11	0.31	1.15
fa04	513	0.42	0.43	0.34	0.26	0.32	1.10
fa05	513	0.77	0.77	0.78	0.68	0.49	1.11
fa06	513	0.55	0.57	0.51	0.42	0.50	1.08
fa07	513	0.40	0.40	0.29	0.24	0.47	1.08
fa08	513	0.56	0.56	0.50	0.42	0.44	1.14
fa09	513	0.63	0.62	0.59	0.50	0.46	1.18
fa10	513	0.63	0.62	0.57	0.50	0.53	1.20

fa1$item.stats %>%
  ggplot(aes(x = row.names(fa1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Faith. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))

kable(fa1$alpha.drop,
      caption = "Faith. Subscale statistics when item drop",
      label = 21, digits = 2,
      col.names = alpha_drop)

Table 21: Faith. Subscale statistics when item drop

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Var(r)	Median interitem correlation
fa01	0.70	0.70	0.76	0.21	2.34	0.02	0.04	0.23
fa02	0.73	0.73	0.78	0.23	2.76	0.02	0.04	0.25
fa03	0.78	0.78	0.82	0.28	3.50	0.01	0.04	0.29
fa04	0.76	0.76	0.80	0.26	3.13	0.02	0.05	0.25
fa05	0.70	0.70	0.76	0.20	2.31	0.02	0.04	0.23
fa06	0.74	0.74	0.79	0.24	2.79	0.02	0.05	0.27
fa07	0.76	0.76	0.81	0.26	3.19	0.02	0.05	0.29
fa08	0.74	0.74	0.79	0.24	2.82	0.02	0.04	0.25
fa09	0.73	0.73	0.78	0.23	2.66	0.02	0.04	0.24
fa10	0.73	0.73	0.79	0.23	2.65	0.02	0.05	0.24

kable(fa1$response.freq,
      caption = "Faith. Non missing response frequency for each item",
      label = 22, digits = 2)

Table 22: Faith. Non missing response frequency for each item

	0	1	2	3	4	5	miss
fa01	0.04	0.16	0.31	0.34	0.12	0.03	0
fa02	0.08	0.20	0.36	0.21	0.12	0.02	0
fa03	0.19	0.34	0.30	0.11	0.05	0.02	0
fa04	0.15	0.34	0.33	0.13	0.04	0.01	0
fa05	0.05	0.12	0.33	0.34	0.13	0.03	0
fa06	0.05	0.12	0.31	0.38	0.11	0.03	0
fa07	0.05	0.15	0.33	0.34	0.11	0.02	0
fa08	0.06	0.20	0.38	0.24	0.09	0.03	0
fa09	0.06	0.19	0.34	0.26	0.13	0.03	0
fa10	0.04	0.12	0.31	0.31	0.14	0.08	0

Dependability

de1 <- psych::alpha(
  taia %>% select(all_of(de_items)),
  cumulative = TRUE,
  title = "Dependability Factor",
  check.keys = FALSE
)

Some items ( de04 ) were negatively correlated with the total scale and 
probably should be reversed.  
To do this, run the function again with the 'check.keys=TRUE' option

kable(de1$total,
      caption = "Dependability. Subscale statistics", 
      label = 23, digits = 2,
      col.names = total_colnames)

Table 23: Dependability. Subscale statistics

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Scale Mean	Total Score SD	Median interitem correlation
	0.74	0.74	0.79	0.2	2.82	0.02	28.11	6.7	0.24

de1$item.stats$mean <- de1$item.stats$mean / 5
kable(de1$item.stats,
      caption = "Dependability. Items statistics",
      label = 24, digits = 2,
      col.names = item_stats_colnames)

Table 24: Dependability. Items statistics

	Num. of Obs.	Discrimination	Std Cor	Cor Overlap Corrected	Cor if drop	Difficulty	SD
de01	513	0.58	0.59	0.53	0.45	0.52	1.11
de02	513	0.72	0.72	0.70	0.62	0.44	1.16
de03	513	0.66	0.65	0.61	0.53	0.44	1.21
de04	513	-0.24	-0.24	-0.41	-0.38	0.38	1.06
de05	513	0.58	0.57	0.55	0.44	0.71	1.18
de06	513	0.67	0.66	0.62	0.55	0.45	1.23
de07	513	0.58	0.60	0.54	0.47	0.56	1.02
de08	513	0.67	0.68	0.65	0.57	0.53	1.05
de09	513	0.44	0.43	0.37	0.27	0.68	1.21
de10	513	0.73	0.73	0.72	0.63	0.45	1.20
de11	513	0.40	0.39	0.27	0.23	0.46	1.20

de1$item.stats %>%
  ggplot(aes(x = row.names(de1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Dependability. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))

kable(de1$alpha.drop,
      caption = "Dependability. Subscale statistics when item drop",
      label = 25, digits = 2,
      col.names = alpha_drop)

Table 25: Dependability. Subscale statistics when item drop

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Var(r)	Median interitem correlation
de01	0.72	0.71	0.77	0.20	2.44	0.02	0.07	0.21
de02	0.69	0.69	0.75	0.18	2.19	0.02	0.07	0.21
de03	0.70	0.70	0.76	0.19	2.31	0.02	0.07	0.21
de04	0.81	0.81	0.83	0.30	4.33	0.01	0.02	0.31
de05	0.72	0.71	0.75	0.20	2.47	0.02	0.07	0.20
de06	0.70	0.70	0.76	0.19	2.30	0.02	0.07	0.21
de07	0.72	0.71	0.77	0.19	2.42	0.02	0.07	0.21
de08	0.70	0.69	0.76	0.18	2.26	0.02	0.06	0.21
de09	0.74	0.73	0.77	0.22	2.77	0.02	0.07	0.29
de10	0.69	0.68	0.75	0.18	2.16	0.02	0.07	0.21
de11	0.75	0.74	0.80	0.22	2.85	0.02	0.08	0.31

kable(de1$response.freq,
      caption = "Dependability. Non missing response frequency for each item",
      label = 26, digits = 2)

Table 26: Dependability. Non missing response frequency for each item

	0	1	2	3	4	5	miss
de01	0.05	0.10	0.25	0.42	0.15	0.03	0
de02	0.09	0.17	0.36	0.26	0.11	0.02	0
de03	0.10	0.16	0.34	0.28	0.09	0.03	0
de04	0.07	0.26	0.44	0.14	0.05	0.02	0
de05	0.02	0.04	0.10	0.28	0.33	0.22	0
de06	0.10	0.17	0.32	0.28	0.11	0.03	0
de07	0.03	0.05	0.27	0.41	0.20	0.04	0
de08	0.04	0.10	0.25	0.44	0.15	0.03	0
de09	0.01	0.06	0.13	0.27	0.32	0.20	0
de10	0.10	0.14	0.29	0.34	0.10	0.02	0
de11	0.07	0.20	0.28	0.30	0.12	0.03	0

Understanding

un1 <- psych::alpha(
  taia %>% select(all_of(un_items)),
  cumulative = TRUE,
  title = "Understanding Factor",
  check.keys = FALSE
)

kable(un1$total,
      caption = "Understanding. Subscale statistics", 
      label = 27, digits = 2,
      col.names = total_colnames)

Table 27: Understanding. Subscale statistics

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Scale Mean	Total Score SD	Median interitem correlation
	0.92	0.92	0.92	0.5	12.04	0.01	31.37	10.2	0.52

un1$item.stats$mean <- un1$item.stats$mean / 5
kable(un1$item.stats,
      caption = "Understanding. Items statistics",
      label = 28, digits = 2,
      col.names = item_stats_colnames)

Table 28: Understanding. Items statistics

	Num. of Obs.	Discrimination	Std Cor	Cor Overlap Corrected	Cor if drop	Difficulty	SD
un01	513	0.76	0.76	0.74	0.71	0.59	1.06
un02	513	0.84	0.84	0.84	0.80	0.50	1.14
un03	513	0.60	0.60	0.54	0.52	0.60	1.17
un04	513	0.77	0.77	0.75	0.72	0.52	1.09
un05	513	0.81	0.81	0.80	0.77	0.57	1.11
un06	513	0.51	0.51	0.44	0.42	0.46	1.23
un07	513	0.73	0.73	0.70	0.67	0.43	1.19
un08	513	0.77	0.77	0.75	0.72	0.58	1.16
un09	513	0.74	0.73	0.70	0.68	0.47	1.23
un10	513	0.75	0.75	0.73	0.70	0.45	1.16
un11	513	0.79	0.79	0.77	0.74	0.53	1.20
un12	513	0.76	0.76	0.74	0.70	0.58	1.13

un1$item.stats %>%
  ggplot(aes(x = row.names(un1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Understanding. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))

kable(un1$alpha.drop,
      caption = "Understanding. Subscale statistics when item drop",
      label = 29, digits = 2,
      col.names = alpha_drop)

Table 29: Understanding. Subscale statistics when item drop

	Alpha	Standardized Alpha	Guttman’s Lambda 6	Average interitem correlation	S/N	Alpha SE	Var(r)	Median interitem correlation
un01	0.91	0.92	0.92	0.50	10.86	0.01	0.01	0.52
un02	0.91	0.91	0.91	0.48	10.31	0.01	0.01	0.51
un03	0.92	0.92	0.92	0.52	12.04	0.01	0.01	0.55
un04	0.91	0.92	0.92	0.50	10.80	0.01	0.01	0.52
un05	0.91	0.91	0.91	0.49	10.50	0.01	0.01	0.52
un06	0.93	0.93	0.93	0.54	12.78	0.00	0.01	0.55
un07	0.92	0.92	0.92	0.50	11.09	0.01	0.01	0.52
un08	0.91	0.92	0.91	0.50	10.79	0.01	0.01	0.52
un09	0.92	0.92	0.92	0.50	11.05	0.01	0.01	0.52
un10	0.91	0.92	0.92	0.50	10.92	0.01	0.01	0.52
un11	0.91	0.91	0.91	0.49	10.65	0.01	0.01	0.51
un12	0.91	0.92	0.92	0.50	10.86	0.01	0.01	0.52

kable(un1$response.freq,
      caption = "Understanding. Non missing response frequency for each item",
      label = 30, digits = 2)

Table 30: Understanding. Non missing response frequency for each item

	0	1	2	3	4	5	miss
un01	0.03	0.07	0.19	0.42	0.24	0.05	0
un02	0.05	0.13	0.29	0.35	0.14	0.03	0
un03	0.03	0.08	0.16	0.36	0.28	0.08	0
un04	0.04	0.13	0.24	0.41	0.17	0.03	0
un05	0.04	0.08	0.19	0.43	0.21	0.05	0
un06	0.06	0.24	0.29	0.25	0.13	0.04	0
un07	0.09	0.20	0.30	0.29	0.10	0.02	0
un08	0.04	0.08	0.19	0.40	0.23	0.07	0
un09	0.08	0.18	0.25	0.31	0.16	0.02	0
un10	0.06	0.19	0.33	0.27	0.12	0.02	0
un11	0.05	0.13	0.24	0.35	0.18	0.05	0
un12	0.04	0.08	0.20	0.40	0.23	0.06	0

Items exclusion

Exploratory Factor Analysis

6 factors, varimax rotation

efa_6f_vm <- factanal(taia %>% select(all_of(taia_items)),
                   factors = 6,
                   scores = "regression",
                   rotation = "varimax")

loadings(efa_6f_vm)

Loadings:
     Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
pr01  0.511   0.438   0.167           0.268         
pr02  0.330   0.376   0.233                   0.173 
pr03  0.177                   0.110   0.612         
pr04         -0.150           0.134   0.440         
pr05  0.227   0.384   0.156   0.108           0.653 
pr06  0.518   0.260   0.150                   0.113 
pr07  0.417   0.511                   0.193   0.126 
pr08  0.550   0.383   0.135           0.192         
pr09  0.406   0.322   0.150           0.136         
pr10  0.376   0.284   0.137                         
co01  0.283   0.663                                 
co02  0.229   0.614   0.120                         
co03  0.465   0.344                   0.119   0.138 
co04  0.577   0.110   0.127           0.103         
co05  0.190   0.705                  -0.109         
co06  0.217   0.531          -0.140                 
co07 -0.357  -0.104  -0.101   0.117           0.128 
co08          0.450          -0.145  -0.454         
co09  0.132   0.676                  -0.174         
co10  0.228   0.518   0.211          -0.152         
ut01  0.810                                         
ut02  0.803           0.105           0.112   0.140 
ut03  0.419  -0.154           0.128   0.570         
ut04  0.485                   0.114           0.145 
ut05  0.606   0.181                           0.105 
ut06  0.731   0.139                           0.133 
ut07  0.565   0.188                                 
ut08  0.609   0.212                                 
ut09  0.613   0.151                           0.148 
ut10                 -0.118           0.259         
ut11  0.392   0.267   0.174                   0.577 
ut12  0.625   0.193   0.137           0.125         
fa01  0.251   0.368           0.640                 
fa02                 -0.192   0.628   0.111         
fa03 -0.101   0.438                  -0.306   0.115 
fa04          0.582                  -0.133   0.123 
fa05  0.251   0.429           0.621                 
fa06  0.281   0.580   0.111   0.207   0.221         
fa07                          0.174   0.489   0.182 
fa08                 -0.180   0.580   0.190   0.120 
fa09                 -0.130   0.589   0.247   0.110 
fa10  0.251   0.134           0.611                 
de01  0.303   0.422   0.158                         
de02  0.261   0.570   0.138           0.173   0.191 
de03  0.216   0.500   0.117   0.149           0.186 
de04 -0.462  -0.154  -0.147                         
de05  0.558   0.118   0.132           0.329         
de06  0.218   0.361   0.181   0.190   0.135   0.610 
de07  0.463   0.285   0.216           0.110   0.149 
de08  0.365   0.389   0.184   0.123   0.201   0.182 
de09  0.285                           0.558         
de10  0.287   0.508           0.176   0.110   0.312 
de11                          0.179   0.351   0.236 
un01  0.316           0.727                         
un02          0.148   0.807                         
un03  0.235           0.501  -0.241                 
un04  0.137   0.125   0.712                         
un05  0.225           0.783                         
un06 -0.151           0.488           0.243         
un07          0.310   0.646          -0.140   0.115 
un08  0.227           0.744                         
un09          0.182   0.664                   0.181 
un10          0.277   0.690  -0.114  -0.100         
un11                  0.757                         
un12  0.277           0.709                         

               Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
SS loadings      8.708   7.011   6.516   2.794   2.782   1.803
Proportion Var   0.134   0.108   0.100   0.043   0.043   0.028
Cumulative Var   0.134   0.242   0.342   0.385   0.428   0.456

kable(sort(efa_6f_vm$uniquenesses, decreasing = TRUE), col.names = "U")

	U
ut10	0.9073192
co07	0.8183857
de11	0.7822050
pr04	0.7591429
pr10	0.7435298
de04	0.7386776
ut04	0.7276062
de01	0.6927754
fa07	0.6896196
fa03	0.6893869
pr09	0.6867794
un06	0.6754405
pr02	0.6569559
ut07	0.6412519
co06	0.6409573
un03	0.6324479
de03	0.6312699
pr06	0.6270480
de07	0.6223023
co04	0.6192165
co03	0.6178353
fa04	0.6107644
co10	0.6080403
de09	0.6057377
de08	0.5934608
ut05	0.5796609
pr03	0.5755150
ut08	0.5742453
fa08	0.5702292
ut09	0.5690733
fa09	0.5635590
co08	0.5522230
de05	0.5493456
co02	0.5476391
fa10	0.5387218
fa02	0.5357916
ut12	0.5316183
de10	0.5162880
de02	0.5152999
pr07	0.4950670
pr08	0.4938099
co09	0.4888758
un09	0.4762922
fa06	0.4723240
co01	0.4635556
ut03	0.4558692
co05	0.4538278
un04	0.4458240
un07	0.4442298
pr01	0.4373561
ut06	0.4224545
un10	0.4212091
un12	0.4164551
ut11	0.3975327
un11	0.3965605
un08	0.3900697
fa01	0.3826694
un01	0.3632078
de06	0.3629276
fa05	0.3610612
ut01	0.3310036
pr05	0.3296280
un05	0.3281390
un02	0.3133867
ut02	0.3056410

6 factors, promax rotation

efa_6f_pm <- factanal(taia %>% select(all_of(taia_items)),
                   factors = 6,
                   scores = "regression",
                   rotation = "promax")

loadings(efa_6f_pm)

Loadings:
     Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
pr01  0.433   0.255           0.272                 
pr02  0.303   0.156   0.127                   0.147 
pr03                 -0.117   0.688                 
pr04 -0.170                   0.483                 
pr05  0.108   0.120                           0.747 
pr06  0.150   0.468                                 
pr07  0.513   0.170           0.173                 
pr08  0.362   0.367           0.192                 
pr09  0.307   0.242           0.131                 
pr10  0.232   0.276                  -0.106         
co01  0.777                                  -0.113 
co02  0.729                                  -0.124 
co03  0.268   0.342                           0.103 
co04          0.557                          -0.116 
co05  0.848          -0.100  -0.107                 
co06  0.629                          -0.164         
co07 -0.105  -0.361                           0.173 
co08  0.560          -0.174  -0.487                 
co09  0.793          -0.112  -0.190                 
co10  0.567           0.113  -0.158                 
ut01 -0.260   0.957                                 
ut02 -0.236   0.905                           0.137 
ut03 -0.204   0.330  -0.103   0.613                 
ut04 -0.199   0.596          -0.113           0.162 
ut05          0.645                                 
ut06          0.803                           0.124 
ut07  0.113   0.587                                 
ut08  0.140   0.583                                 
ut09          0.643                           0.144 
ut10  0.127  -0.199  -0.168   0.307  -0.102         
ut11          0.357                           0.664 
ut12          0.585                                 
fa01  0.345           0.115           0.674         
fa02 -0.119                           0.642         
fa03  0.487  -0.183          -0.364           0.115 
fa04  0.680  -0.308          -0.166                 
fa05  0.437                           0.657         
fa06  0.639                   0.211   0.154         
fa07         -0.141           0.496           0.170 
fa08 -0.111  -0.117                   0.568   0.112 
fa09                          0.159   0.570         
fa10          0.228          -0.104   0.673  -0.136 
de01  0.455   0.101                                 
de02  0.585                   0.152           0.140 
de03  0.482                           0.110   0.150 
de04         -0.429                                 
de05          0.438           0.355                 
de06                                          0.688 
de07  0.172   0.348   0.105                   0.123 
de08  0.321   0.151           0.161           0.142 
de09                          0.642  -0.106         
de10  0.433                                   0.300 
de11         -0.101           0.319           0.250 
un01 -0.160   0.219   0.805           0.138  -0.112 
un02         -0.118   0.860                         
un03          0.141   0.458          -0.237         
un04                  0.743                         
un05                  0.845                         
un06         -0.387   0.539   0.320                 
un07  0.223  -0.138   0.644  -0.154           0.101 
un08 -0.151   0.118   0.824           0.123         
un09                  0.658                   0.191 
un10  0.225  -0.214   0.703                         
un11                  0.804                         
un12 -0.195   0.187   0.746                         

               Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
SS loadings      7.517   7.235   6.633   3.061   2.736   2.155
Proportion Var   0.116   0.111   0.102   0.047   0.042   0.033
Cumulative Var   0.116   0.227   0.329   0.376   0.418   0.451

kable(sort(efa_6f_pm$uniquenesses, decreasing = TRUE), col.names = "U")

	U
ut10	0.9073192
co07	0.8183857
de11	0.7822050
pr04	0.7591429
pr10	0.7435298
de04	0.7386776
ut04	0.7276062
de01	0.6927754
fa07	0.6896196
fa03	0.6893869
pr09	0.6867794
un06	0.6754405
pr02	0.6569559
ut07	0.6412519
co06	0.6409573
un03	0.6324479
de03	0.6312699
pr06	0.6270480
de07	0.6223023
co04	0.6192165
co03	0.6178353
fa04	0.6107644
co10	0.6080403
de09	0.6057377
de08	0.5934608
ut05	0.5796609
pr03	0.5755150
ut08	0.5742453
fa08	0.5702292
ut09	0.5690733
fa09	0.5635590
co08	0.5522230
de05	0.5493456
co02	0.5476391
fa10	0.5387218
fa02	0.5357916
ut12	0.5316183
de10	0.5162880
de02	0.5152999
pr07	0.4950670
pr08	0.4938099
co09	0.4888758
un09	0.4762922
fa06	0.4723240
co01	0.4635556
ut03	0.4558692
co05	0.4538278
un04	0.4458240
un07	0.4442298
pr01	0.4373561
ut06	0.4224545
un10	0.4212091
un12	0.4164551
ut11	0.3975327
un11	0.3965605
un08	0.3900697
fa01	0.3826694
un01	0.3632078
de06	0.3629276
fa05	0.3610612
ut01	0.3310036
pr05	0.3296280
un05	0.3281390
un02	0.3133867
ut02	0.3056410

Confirmatory Factor Analysis

Model:

mdl1 <- "
PR =~ pr01 + pr02 + pr03 + pr04 + pr05 + pr06 + pr07 + pr08 + pr09 + pr10
CO =~ co01 + co02 + co03 + co04 + co05 + co06 + co07 + co08 + co09 + co10
UT =~ ut01 + ut02 + ut03 + ut04 + ut05 + ut06 + ut07 + ut08 + ut09 + ut10 + ut11 + ut12
FA =~ fa01 + fa02 + fa03 + fa04 + fa05 + fa06 + fa07 + fa08 + fa09 + fa10
DE =~ de01 + de02 + de03 + de04 + de05 + de06 + de07 + de08 + de09 + de10 + de11
UN =~ un01 + un02 + un03 + un04 + un05 + un06 + un07 + un08 + un09 + un10 + un11 + un12
"

CFA model fitting:

model1 <- cfa(mdl1, taia %>% select(all_of(taia_items)))

Fit measures:

kable(
  tibble(Measure = c("Chi-Squared", "DF", "p", "GFI", "AGFI", "CFI", "TLI", "SRMR", "RMSEA"),
               Value = round(
                 fitmeasures(model1, c("chisq", "df", "pvalue", "gfi", "agfi", "cfi", "tli", "srmr", "rmsea")), 4)
    )
)

Measure	Value
Chi-Squared	7107.8205
DF	2000.0000
p	0.0000
GFI	0.6218
AGFI	0.5943
CFI	0.6975
TLI	0.6854
SRMR	0.0997
RMSEA	0.0706

Standardized solution:

smodel1 <- standardizedsolution(model1)

Loadings:

kable(
  smodel1 %>% 
    filter(op == "=~") %>% 
    mutate_at(vars(4:9), function(x) round(x, 3)),
  col.names = c("Factor", "", "Item", "Loading", "SE", "z", "p", "CI lower bound", "CI upper bound")
)

Factor		Item	Loading	SE	z	p	CI lower bound	CI upper bound
PR	=~	pr01	0.767	0.021	37.025	0.000	0.727	0.808
PR	=~	pr02	0.602	0.030	19.788	0.000	0.542	0.661
PR	=~	pr03	0.207	0.044	4.682	0.000	0.121	0.294
PR	=~	pr04	0.062	0.046	1.349	0.177	-0.028	0.152
PR	=~	pr05	0.575	0.032	18.138	0.000	0.513	0.638
PR	=~	pr06	0.606	0.030	20.070	0.000	0.547	0.665
PR	=~	pr07	0.729	0.023	31.541	0.000	0.684	0.774
PR	=~	pr08	0.730	0.023	31.634	0.000	0.685	0.775
PR	=~	pr09	0.598	0.031	19.577	0.000	0.538	0.658
PR	=~	pr10	0.520	0.034	15.114	0.000	0.452	0.587
CO	=~	co01	0.743	0.023	32.138	0.000	0.698	0.789
CO	=~	co02	0.702	0.026	27.452	0.000	0.652	0.753
CO	=~	co03	0.523	0.035	14.936	0.000	0.454	0.591
CO	=~	co04	0.368	0.041	8.982	0.000	0.288	0.448
CO	=~	co05	0.779	0.021	37.209	0.000	0.738	0.820
CO	=~	co06	0.628	0.030	21.072	0.000	0.569	0.686
CO	=~	co07	-0.248	0.044	-5.620	0.000	-0.335	-0.162
CO	=~	co08	0.373	0.041	9.152	0.000	0.293	0.453
CO	=~	co09	0.738	0.023	31.430	0.000	0.692	0.784
CO	=~	co10	0.626	0.030	20.974	0.000	0.568	0.685
UT	=~	ut01	0.774	0.020	38.677	0.000	0.735	0.814
UT	=~	ut02	0.838	0.016	52.962	0.000	0.807	0.869
UT	=~	ut03	0.431	0.038	11.352	0.000	0.356	0.505
UT	=~	ut04	0.489	0.036	13.755	0.000	0.420	0.559
UT	=~	ut05	0.662	0.027	24.620	0.000	0.610	0.715
UT	=~	ut06	0.762	0.021	36.557	0.000	0.721	0.803
UT	=~	ut07	0.583	0.031	18.659	0.000	0.521	0.644
UT	=~	ut08	0.645	0.028	23.086	0.000	0.590	0.699
UT	=~	ut09	0.672	0.026	25.455	0.000	0.620	0.723
UT	=~	ut10	-0.016	0.046	-0.338	0.735	-0.106	0.075
UT	=~	ut11	0.532	0.034	15.802	0.000	0.466	0.598
UT	=~	ut12	0.702	0.025	28.542	0.000	0.654	0.750
FA	=~	fa01	0.826	0.019	43.688	0.000	0.789	0.863
FA	=~	fa02	0.360	0.041	8.678	0.000	0.278	0.441
FA	=~	fa03	0.207	0.045	4.581	0.000	0.118	0.296
FA	=~	fa04	0.380	0.041	9.330	0.000	0.301	0.460
FA	=~	fa05	0.850	0.018	48.152	0.000	0.815	0.884
FA	=~	fa06	0.619	0.031	20.287	0.000	0.560	0.679
FA	=~	fa07	0.238	0.045	5.325	0.000	0.150	0.325
FA	=~	fa08	0.343	0.042	8.168	0.000	0.260	0.425
FA	=~	fa09	0.420	0.039	10.650	0.000	0.342	0.497
FA	=~	fa10	0.589	0.032	18.368	0.000	0.526	0.652
DE	=~	de01	0.578	0.032	18.128	0.000	0.515	0.640
DE	=~	de02	0.701	0.025	27.887	0.000	0.652	0.750
DE	=~	de03	0.601	0.031	19.538	0.000	0.540	0.661
DE	=~	de04	-0.455	0.037	-12.178	0.000	-0.529	-0.382
DE	=~	de05	0.522	0.035	15.095	0.000	0.454	0.590
DE	=~	de06	0.622	0.030	20.974	0.000	0.563	0.680
DE	=~	de07	0.618	0.030	20.741	0.000	0.560	0.677
DE	=~	de08	0.690	0.026	26.769	0.000	0.640	0.741
DE	=~	de09	0.280	0.043	6.509	0.000	0.196	0.364
DE	=~	de10	0.699	0.025	27.660	0.000	0.649	0.748
DE	=~	de11	0.198	0.045	4.437	0.000	0.111	0.286
UN	=~	un01	0.750	0.021	35.714	0.000	0.709	0.791
UN	=~	un02	0.825	0.016	51.916	0.000	0.794	0.857
UN	=~	un03	0.552	0.032	17.112	0.000	0.489	0.615
UN	=~	un04	0.746	0.021	35.122	0.000	0.705	0.788
UN	=~	un05	0.807	0.017	46.861	0.000	0.773	0.840
UN	=~	un06	0.432	0.037	11.522	0.000	0.358	0.505
UN	=~	un07	0.697	0.024	28.655	0.000	0.649	0.745
UN	=~	un08	0.760	0.020	37.374	0.000	0.720	0.800
UN	=~	un09	0.700	0.024	28.953	0.000	0.652	0.747
UN	=~	un10	0.719	0.023	31.319	0.000	0.674	0.764
UN	=~	un11	0.773	0.019	39.708	0.000	0.735	0.811
UN	=~	un12	0.744	0.021	34.839	0.000	0.702	0.786

Covariances:

kable(
  smodel1 %>% 
    filter(op == "~~" & lhs != rhs) %>% 
    mutate_at(vars(4:9), function(x) round(x, 3)),
  col.names = c("Factor", "", "Factor", "Covariance", "SE", "z", "p", "CI lower bound", "CI upper bound")
)

Factor		Factor	Covariance	SE	z	p	CI lower bound	CI upper bound
PR	~~	CO	0.701	0.030	23.747	0.00	0.643	0.759
PR	~~	UT	0.770	0.024	31.846	0.00	0.722	0.817
PR	~~	FA	0.549	0.038	14.491	0.00	0.475	0.623
PR	~~	DE	0.894	0.018	50.899	0.00	0.859	0.928
PR	~~	UN	0.421	0.041	10.162	0.00	0.340	0.502
CO	~~	UT	0.469	0.040	11.769	0.00	0.391	0.547
CO	~~	FA	0.480	0.041	11.816	0.00	0.400	0.559
CO	~~	DE	0.659	0.032	20.450	0.00	0.596	0.722
CO	~~	UN	0.328	0.044	7.444	0.00	0.242	0.415
UT	~~	FA	0.412	0.042	9.755	0.00	0.329	0.495
UT	~~	DE	0.699	0.029	24.200	0.00	0.642	0.755
UT	~~	UN	0.333	0.043	7.734	0.00	0.248	0.417
FA	~~	DE	0.640	0.034	19.071	0.00	0.574	0.705
FA	~~	UN	0.088	0.049	1.815	0.07	-0.007	0.184
DE	~~	UN	0.409	0.042	9.717	0.00	0.326	0.491

Residuals:

kable(
  smodel1 %>% 
    filter(op == "~~" & lhs == rhs) %>% 
    mutate_at(vars(4:9), function(x) round(x, 3)) %>% 
    select(-(2:3)),
  col.names = c("Item", "Residual", "SE", "z", "p", "CI lower bound", "CI upper bound")
)

Item	Residual	SE	z	p	CI lower bound	CI upper bound
pr01	0.411	0.032	12.942	0	0.349	0.474
pr02	0.638	0.037	17.449	0	0.566	0.710
pr03	0.957	0.018	52.044	0	0.921	0.993
pr04	0.996	0.006	174.276	0	0.985	1.007
pr05	0.669	0.037	18.314	0	0.597	0.740
pr06	0.633	0.037	17.317	0	0.561	0.705
pr07	0.468	0.034	13.900	0	0.402	0.535
pr08	0.467	0.034	13.882	0	0.401	0.533
pr09	0.642	0.037	17.551	0	0.570	0.714
pr10	0.730	0.036	20.422	0	0.660	0.800
co01	0.447	0.034	13.002	0	0.380	0.515
co02	0.507	0.036	14.092	0	0.436	0.577
co03	0.727	0.037	19.882	0	0.655	0.799
co04	0.865	0.030	28.690	0	0.806	0.924
co05	0.393	0.033	12.037	0	0.329	0.457
co06	0.606	0.037	16.203	0	0.533	0.679
co07	0.938	0.022	42.790	0	0.895	0.981
co08	0.861	0.030	28.267	0	0.801	0.920
co09	0.456	0.035	13.151	0	0.388	0.523
co10	0.608	0.037	16.245	0	0.534	0.681
ut01	0.400	0.031	12.912	0	0.340	0.461
ut02	0.299	0.026	11.270	0	0.247	0.350
ut03	0.814	0.033	24.905	0	0.750	0.878
ut04	0.760	0.035	21.825	0	0.692	0.829
ut05	0.561	0.036	15.737	0	0.491	0.631
ut06	0.420	0.032	13.219	0	0.357	0.482
ut07	0.661	0.036	18.151	0	0.589	0.732
ut08	0.584	0.036	16.237	0	0.514	0.655
ut09	0.549	0.035	15.491	0	0.480	0.618
ut10	1.000	0.001	696.420	0	0.997	1.003
ut11	0.717	0.036	19.992	0	0.646	0.787
ut12	0.507	0.035	14.700	0	0.440	0.575
fa01	0.318	0.031	10.172	0	0.256	0.379
fa02	0.871	0.030	29.210	0	0.812	0.929
fa03	0.957	0.019	51.134	0	0.920	0.994
fa04	0.855	0.031	27.568	0	0.794	0.916
fa05	0.278	0.030	9.259	0	0.219	0.337
fa06	0.616	0.038	16.300	0	0.542	0.691
fa07	0.944	0.021	44.524	0	0.902	0.985
fa08	0.883	0.029	30.690	0	0.826	0.939
fa09	0.824	0.033	24.898	0	0.759	0.889
fa10	0.653	0.038	17.275	0	0.579	0.727
de01	0.666	0.037	18.067	0	0.594	0.738
de02	0.509	0.035	14.429	0	0.439	0.578
de03	0.639	0.037	17.319	0	0.567	0.712
de04	0.793	0.034	23.283	0	0.726	0.859
de05	0.728	0.036	20.177	0	0.657	0.798
de06	0.614	0.037	16.662	0	0.542	0.686
de07	0.618	0.037	16.762	0	0.546	0.690
de08	0.524	0.036	14.717	0	0.454	0.593
de09	0.922	0.024	38.260	0	0.874	0.969
de10	0.512	0.035	14.486	0	0.442	0.581
de11	0.961	0.018	54.124	0	0.926	0.995
un01	0.438	0.031	13.890	0	0.376	0.499
un02	0.319	0.026	12.139	0	0.267	0.370
un03	0.695	0.036	19.530	0	0.626	0.765
un04	0.443	0.032	13.978	0	0.381	0.505
un05	0.349	0.028	12.588	0	0.295	0.404
un06	0.814	0.032	25.176	0	0.750	0.877
un07	0.514	0.034	15.159	0	0.448	0.581
un08	0.422	0.031	13.656	0	0.362	0.483
un09	0.510	0.034	15.093	0	0.444	0.577
un10	0.483	0.033	14.616	0	0.418	0.548
un11	0.402	0.030	13.356	0	0.343	0.461
un12	0.446	0.032	14.021	0	0.384	0.508
PR	1.000	0.000	NA	NA	1.000	1.000
CO	1.000	0.000	NA	NA	1.000	1.000
UT	1.000	0.000	NA	NA	1.000	1.000
FA	1.000	0.000	NA	NA	1.000	1.000
DE	1.000	0.000	NA	NA	1.000	1.000
UN	1.000	0.000	NA	NA	1.000	1.000

Visualization:

semPaths(model1, "std")

Validation

Data preparation